home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / Morpion 1.0.0 / source / PNL Libraries / MyUtils.unit < prev    next >
Encoding:
Text File  |  1993-12-03  |  7.9 KB  |  379 lines  |  [TEXT/PJMM]
  1. unit MyUtils;
  2.  
  3. interface
  4.  
  5.     function TrapAvailable (tNumber: INTEGER): BOOLEAN;
  6.     function MyNumToString (n: longInt): str255;
  7.     function NumToStr (n: longInt): str255;
  8.     function NN (n: longInt; len: integer): str31;
  9.     function N2 (n: longInt): str31;
  10.     function StrToNum (s: str255): longInt;
  11.     procedure DotDotDot (var s: str255; var width: integer);
  12.     procedure SetItemEnable (mh: menuHandle; item: integer; enable: boolean);
  13.     procedure SetIDItemEnable (menu, item: integer; enable: boolean);
  14.     function GetIDItemEnable (menu, item: integer): boolean;
  15.     function GetItemEnable (mh: menuHandle; item: integer): boolean;
  16.     procedure DotItem (mh: menuHandle; item: integer; dotted: boolean);
  17.     function MyFrontWindow: boolean;
  18.     function DAFrontWindow: boolean;
  19.     function GetIndStrSize (size, id, index: integer): str255;
  20.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  21.     function GetVolInfo (var name: str63; var vrn: integer; index: integer; var CrDate: longInt): OSErr;
  22.     procedure PlotSICN (id: integer; index, v, h: integer);
  23.     function HLockState (h: univ handle): signedByte;
  24.     function LookupStrh (id: integer; match: str255): str255;
  25.     function LookupStrhNumber (id: integer; n: longInt): str255;
  26.     procedure MemFill (p: univ ptr; len: longInt; value: integer);
  27.     procedure ZeroFill (p: univ ptr; len: longInt);
  28.     function CheckCancel: boolean;
  29.     procedure TrashHandle (h: handle);
  30.     procedure ZeroBlock (p: ptr; len: longInt);
  31.     function WindowInWindowList (w: windowPtr): boolean;
  32.  
  33.     procedure SegmentInit;
  34.     procedure SegmentUtil;
  35.     procedure SegmentTerm;
  36.  
  37. implementation
  38.  
  39.     uses
  40.         MyTypes, Traps, Folders;
  41.  
  42. {$S Init}
  43.     procedure SegmentInit;
  44.     begin
  45.     end;
  46.  
  47. {$S Util}
  48.     procedure SegmentUtil;
  49.     begin
  50.     end;
  51.  
  52. {$S Term}
  53.     procedure SegmentTerm;
  54.     begin
  55.     end;
  56.  
  57. {$S Util}
  58.     function TrapAvailable (tNumber: INTEGER): BOOLEAN;
  59. {Check to see if a given trap is implemented. Babble as taken from IM6 }
  60.         const
  61.             TrapMask = $0800;
  62.         var
  63.             tType: TrapType;
  64.     begin
  65.         if BAND(tNumber, TrapMask) > 0 then
  66.             tType := ToolTrap
  67.         else
  68.             tType := OSTrap;
  69.         if tType = ToolTrap then begin
  70.             tNumber := BAND(tNumber, $7FF);
  71.             if tNumber >= $400 then
  72.                 tNumber := _Unimplemented
  73.             else if tNumber >= $200 then
  74.                 if NGetTrapAddress($A86E, ToolTrap) <> NGetTrapAddress($AA6E, ToolTrap) then
  75.                     tNumber := _Unimplemented;
  76.         end;
  77.         TrapAvailable := NGetTrapAddress(tNumber, tType) <> GetTrapAddress(_Unimplemented);
  78.     end; {TrapAvailable}
  79.  
  80. {$S Util}
  81.     function MyNumToString (n: longInt): str255;
  82.         var
  83.             s: str255;
  84.     begin
  85.         if abs(n) < 4096 then
  86.             NumToString(n, s)
  87.         else if abs(n) < 4194304 then begin
  88.             NumToString(n div 1024, s);
  89.             s := Concat(s, 'k');
  90.         end
  91.         else begin
  92.             NumToString(n div 1048576, s);
  93.             s := Concat(s, 'M');
  94.         end;
  95.         MyNumToString := s;
  96.     end;
  97.  
  98. {$S Util}
  99.     function NumToStr (n: longInt): str255;
  100.         var
  101.             s: str255;
  102.     begin
  103.         NumToString(n, s);
  104.         NumToStr := s;
  105.     end;
  106.  
  107. {$S Util}
  108.     function NN (n: longInt; len: integer): str31;
  109.         var
  110.             s: str31;
  111.     begin
  112.         s := NumToStr(n);
  113.         while length(s) < len do
  114.             s := concat('0', s);
  115.         NN := s;
  116.     end;
  117.  
  118.     function N2 (n: longInt): str31;
  119.     begin
  120.         N2 := NN(n, 2);
  121.     end;
  122.  
  123. {$S Util}
  124.     function StrToNum (s: str255): longInt;
  125.         var
  126.             n: longInt;
  127.     begin
  128.         StringToNum(s, n);
  129.         StrToNum := n;
  130.     end;
  131.  
  132. {$S Util}
  133.     procedure DotDotDot (var s: str255; var width: integer);
  134.         var
  135.             maxwidth, len: integer;
  136.     begin
  137.         maxwidth := width;
  138.         width := StringWidth(s);
  139.         if width > maxwidth then begin
  140.             width := width + CharWidth('…');
  141. {$PUSH}
  142. {$R-}
  143.             len := ord(s[0]);
  144.             while (len > 0) and (width > maxwidth) do begin
  145.                 width := width - CharWidth(s[len]);
  146.                 len := len - 1;
  147.             end;
  148.             len := len + 1;
  149.             s[0] := chr(len);
  150.             s[len] := '…';
  151. {$POP}
  152.         end;
  153.     end;
  154.  
  155. {$S}
  156.     procedure SetItemEnable (mh: menuHandle; item: integer; enable: boolean);
  157.     begin
  158.         if enable then
  159.             EnableItem(mh, item)
  160.         else
  161.             DisableItem(mh, item);
  162.     end;
  163.  
  164. {$S}
  165.     procedure SetIDItemEnable (menu, item: integer; enable: boolean);
  166.     begin
  167.         SetItemEnable(GetMHandle(menu), item, enable);
  168.     end;
  169.  
  170. {$S}
  171.     function GetItemEnable (mh: menuHandle; item: integer): boolean;
  172.     begin
  173.         if item > 31 then
  174.             GetItemEnable := true
  175.         else
  176.             GetItemEnable := BTST(mh^^.enableFlags, item);
  177.     end;
  178.  
  179. {$S}
  180.     function GetIDItemEnable (menu, item: integer): boolean;
  181.     begin
  182.         GetIDItemEnable := GetItemEnable(GetMHandle(menu), item);
  183.     end;
  184.  
  185. {$S Util}
  186.     procedure DotItem (mh: menuHandle; item: integer; dotted: boolean);
  187.     begin
  188.         if dotted then
  189.             SetItemMark(mh, item, '•')
  190.         else
  191.             SetItemMark(mh, item, chr(0));
  192.     end;
  193.  
  194. {$S Util}
  195.     function MyFrontWindow: boolean;
  196.         var
  197.             wp: windowPtr;
  198.     begin
  199.         wp := FrontWindow;
  200.         if wp = nil then
  201.             MyFrontWindow := false
  202.         else
  203.             MyFrontWindow := windowPeek(wp)^.windowKind >= userKind;
  204.     end;
  205.  
  206. {$S Util}
  207.     function DAFrontWindow: boolean;
  208.         var
  209.             wp: windowPtr;
  210.     begin
  211.         wp := FrontWindow;
  212.         if wp = nil then
  213.             DAFrontWindow := false
  214.         else
  215.             DAFrontWindow := windowPeek(wp)^.windowKind < 0;
  216.     end;
  217.  
  218. {$S Util}
  219.     function GetIndStrSize (size, id, index: integer): str255;
  220.         var
  221.             s: str255;
  222.     begin
  223.         GetIndString(s, id, index);
  224.         GetIndStrSize := copy(s, 1, size - 1);
  225.     end;
  226.  
  227. {$S Util}
  228.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  229.         var
  230.             procID: longInt;
  231.             oe: OSErr;
  232.     begin
  233.         oe := GetWDInfo(wdrn, vrn, dirID, procID);
  234.         if oe <> noErr then begin
  235.             vrn := wdrn;
  236.             dirID := 0;
  237.         end;
  238.         GetDirID := oe;
  239.     end;
  240.  
  241. {$S Util}
  242.     function GetVolInfo (var name: str63; var vrn: integer; index: integer; var CrDate: longInt): OSErr;
  243.         var
  244.             pb: paramBlockRec;
  245.             oe: OSErr;
  246.     begin
  247.         with pb do begin
  248.             if (name <> '') & (name[length(name)] <> ':') then
  249.                 name := concat(name, ':');
  250.             pb.ioNamePtr := @name;
  251.             ioVRefNum := vrn;
  252.             ioVolIndex := index;
  253.             oe := PBGetVInfo(@pb, false);
  254.             if oe = noErr then begin
  255.                 vrn := ioVRefNum;
  256.                 CrDate := ioVCrDate;
  257.             end;
  258.         end;
  259.         GetVolInfo := oe;
  260.     end;
  261.  
  262. {$S Util}
  263.     procedure PlotSICN (id: integer; index, v, h: integer);
  264.         var
  265.             sh: Handle;
  266.             bm: BitMap;
  267.             r: Rect;
  268.             gp: grafptr;
  269.     begin
  270.         sh := GetResource('SICN', id);
  271.         HLock(sh);
  272.         bm.baseAddr := Ptr(longInt(sh^) + (index - 1) * 32);
  273.         bm.rowBytes := 2;
  274.         SetRect(r, h, v, h + 16, v + 16);
  275.         bm.bounds := r;
  276.         GetPort(gp);
  277.         CopyBits(bm, gp^.portBits, r, r, srcCopy, nil);
  278.         HUnlock(sh);
  279.     end;
  280.  
  281.     function HLockState (h: univ handle): signedByte;
  282.     begin
  283.         HLockState := HGetState(h);
  284.         HLock(h);
  285.     end;
  286.  
  287.     function LookupStrh (id: integer; match: str255): str255;
  288.         var
  289.             t, s: str255;
  290.             i: integer;
  291.     begin
  292.         t := '';
  293.         i := 1;
  294.         repeat
  295.             GetIndString(s, id, i);
  296.             if s = match then begin
  297.                 GetIndString(t, id, i + 1);
  298.                 leave;
  299.             end;
  300.             i := i + 2;
  301.         until s = '';
  302.         LookupStrh := t;
  303.     end;
  304.  
  305.     function LookupStrhNumber (id: integer; n: longInt): str255;
  306.         var
  307.             s, t: str255;
  308.     begin
  309.         NumToString(n, s);
  310.         t := LookupStrh(id, s);
  311.         if t = '' then
  312.             t := s;
  313.         LookupStrhNumber := t;
  314.     end;
  315.  
  316.     procedure MemFill (p: univ ptr; len: longInt; value: integer);
  317.     begin
  318.         while (len > 0) do begin
  319.             p^ := value;
  320.             len := len - 1;
  321.             longInt(p) := longInt(p) + 1;
  322.         end;
  323.     end;
  324.  
  325.     procedure ZeroFill (p: univ ptr; len: longInt);
  326.     begin
  327.         MemFill(p, len, 0);
  328.     end;
  329.  
  330. {$S Util}
  331.     function CheckCancel: boolean;
  332.         var
  333.             er: eventRecord;
  334.     begin
  335.         if GetNextEvent(everyEvent, er) then
  336.             with er do
  337.                 CheckCancel := (what = keyDown) and (BAND(message, charCodeMask) = ord('.')) and (BAND(modifiers, cmdKey) <> 0)
  338.         else
  339.             CheckCancel := false;
  340.     end;
  341.  
  342.     procedure TrashHandle (h: handle);
  343.         var
  344.             p: ptr;
  345.             i: longInt;
  346.     begin
  347.         if (h <> nil) & (h^ <> nil) then begin
  348.             p := h^;
  349.             for i := 1 to GetHandleSize(h) do begin
  350.                 p^ := -27;
  351.                 longInt(p) := longInt(p) + 1;
  352.             end;
  353.         end;
  354.     end;
  355.  
  356.     procedure ZeroBlock (p: ptr; len: longInt);
  357.         var
  358.             i: longInt;
  359.     begin
  360.         for i := 1 to len do begin
  361.             p^ := 0;
  362.             longInt(p) := longInt(p) + 1;
  363.         end;
  364.     end;
  365.  
  366.     function WindowInWindowList (w: windowPtr): boolean;
  367.         type
  368.             windowPtrPtr = ^windowPtr;
  369.         var
  370.             nw: windowPtr;
  371.     begin
  372.         nw := windowPtrPtr($9D6)^;
  373.         while (nw <> nil) & (w <> nw) do begin
  374.             nw := windowPtr(windowPeek(nw)^.nextwindow);
  375.         end;
  376.         WindowInWindowList := nw <> nil;
  377.     end;
  378.  
  379. end.